home *** CD-ROM | disk | FTP | other *** search
/ An Invitation to the Roland World of Music / Roland - An Invitation To The Roland World Of Music.bin / vb / cooltool / cooldrum / cooldrum.frm next >
Text File  |  1995-05-26  |  30KB  |  872 lines
  1. VERSION 2.00
  2. Begin Form CoolDrum 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00C0C0C0&
  5.    BorderStyle     =   3  'Fixed Double
  6.    Caption         =   "Cool Drum"
  7.    ClientHeight    =   3600
  8.    ClientLeft      =   855
  9.    ClientTop       =   1890
  10.    ClientWidth     =   7200
  11.    Height          =   4290
  12.    Icon            =   COOLDRUM.FRX:0000
  13.    Left            =   795
  14.    LinkTopic       =   "Form1"
  15.    MaxButton       =   0   'False
  16.    ScaleHeight     =   3600
  17.    ScaleWidth      =   7200
  18.    Top             =   1260
  19.    Width           =   7320
  20.    Begin Timer Timer1 
  21.       Enabled         =   0   'False
  22.       Interval        =   150
  23.       Left            =   3600
  24.       Top             =   1920
  25.    End
  26.    Begin Frame Frame5 
  27.       BackColor       =   &H00C0C0C0&
  28.       Caption         =   "Transpose Bass"
  29.       FontBold        =   0   'False
  30.       FontItalic      =   0   'False
  31.       FontName        =   "MS Sans Serif"
  32.       FontSize        =   8.25
  33.       FontStrikethru  =   0   'False
  34.       FontUnderline   =   0   'False
  35.       Height          =   1455
  36.       Left            =   2040
  37.       TabIndex        =   22
  38.       Top             =   2040
  39.       Width           =   1575
  40.       Begin VSlider VSlider1 
  41.          BackColor       =   &H00C0C0C0&
  42.          BevelInner      =   0  'None
  43.          BevelOuter      =   1  'Raised
  44.          BevelWidth      =   1
  45.          BorderWidth     =   1
  46.          Gap             =   3
  47.          Height          =   975
  48.          LargeChange     =   1
  49.          Left            =   240
  50.          LinkControl     =   ""
  51.          LinkProperty    =   ""
  52.          Max             =   12
  53.          Min             =   -12
  54.          ThumbHeight     =   220
  55.          ThumbStyle      =   3  'Lined
  56.          ThumbWidth      =   360
  57.          TickColor       =   &H00000000&
  58.          TickCount       =   3
  59.          TickLength      =   4
  60.          TickMarks       =   3  'Both
  61.          TickWidth       =   1
  62.          Top             =   360
  63.          TrackBevel      =   1  'Raised
  64.          TrackWidth      =   0
  65.          Value           =   0
  66.          Width           =   1080
  67.       End
  68.    End
  69.    Begin Frame Frame4 
  70.       BackColor       =   &H00C0C0C0&
  71.       Caption         =   "Bass "
  72.       FontBold        =   0   'False
  73.       FontItalic      =   0   'False
  74.       FontName        =   "MS Sans Serif"
  75.       FontSize        =   8.25
  76.       FontStrikethru  =   0   'False
  77.       FontUnderline   =   0   'False
  78.       Height          =   1455
  79.       Left            =   120
  80.       TabIndex        =   18
  81.       Top             =   2040
  82.       Width           =   1575
  83.       Begin OptionButton OptionBass 
  84.          BackColor       =   &H00C0C0C0&
  85.          Caption         =   "None"
  86.          FontBold        =   0   'False
  87.          FontItalic      =   0   'False
  88.          FontName        =   "MS Sans Serif"
  89.          FontSize        =   8.25
  90.          FontStrikethru  =   0   'False
  91.          FontUnderline   =   0   'False
  92.          Height          =   255
  93.          Index           =   2
  94.          Left            =   120
  95.          TabIndex        =   21
  96.          Top             =   1080
  97.          Value           =   -1  'True
  98.          Width           =   975
  99.       End
  100.       Begin OptionButton OptionBass 
  101.          BackColor       =   &H00C0C0C0&
  102.          Caption         =   "Bass 2"
  103.          FontBold        =   0   'False
  104.          FontItalic      =   0   'False
  105.          FontName        =   "MS Sans Serif"
  106.          FontSize        =   8.25
  107.          FontStrikethru  =   0   'False
  108.          FontUnderline   =   0   'False
  109.          Height          =   255
  110.          Index           =   1
  111.          Left            =   120
  112.          TabIndex        =   20
  113.          Top             =   720
  114.          Width           =   975
  115.       End
  116.       Begin OptionButton OptionBass 
  117.          BackColor       =   &H00C0C0C0&
  118.          Caption         =   "Bass 1"
  119.          FontBold        =   0   'False
  120.          FontItalic      =   0   'False
  121.          FontName        =   "MS Sans Serif"
  122.          FontSize        =   8.25
  123.          FontStrikethru  =   0   'False
  124.          FontUnderline   =   0   'False
  125.          Height          =   255
  126.          Index           =   0
  127.          Left            =   120
  128.          TabIndex        =   19
  129.          Top             =   360
  130.          Width           =   975
  131.       End
  132.    End
  133.    Begin Frame Frame3 
  134.       BackColor       =   &H00C0C0C0&
  135.       Caption         =   "High Hat Beats"
  136.       FontBold        =   0   'False
  137.       FontItalic      =   0   'False
  138.       FontName        =   "MS Sans Serif"
  139.       FontSize        =   8.25
  140.       FontStrikethru  =   0   'False
  141.       FontUnderline   =   0   'False
  142.       Height          =   1455
  143.       Left            =   2040
  144.       TabIndex        =   14
  145.       Top             =   480
  146.       Width           =   1575
  147.       Begin OptionButton OptionCymbal 
  148.          BackColor       =   &H00C0C0C0&
  149.          Caption         =   "None"
  150.          FontBold        =   0   'False
  151.          FontItalic      =   0   'False
  152.          FontName        =   "MS Sans Serif"
  153.          FontSize        =   8.25
  154.          FontStrikethru  =   0   'False
  155.          FontUnderline   =   0   'False
  156.          Height          =   255
  157.          Index           =   2
  158.          Left            =   120
  159.          TabIndex        =   17
  160.          Top             =   1080
  161.          Width           =   1215
  162.       End
  163.       Begin OptionButton OptionCymbal 
  164.          BackColor       =   &H00C0C0C0&
  165.          Caption         =   "High Hat 2"
  166.          FontBold        =   0   'False
  167.          FontItalic      =   0   'False
  168.          FontName        =   "MS Sans Serif"
  169.          FontSize        =   8.25
  170.          FontStrikethru  =   0   'False
  171.          FontUnderline   =   0   'False
  172.          Height          =   255
  173.          Index           =   1
  174.          Left            =   120
  175.          TabIndex        =   16
  176.          Top             =   720
  177.          Width           =   1215
  178.       End
  179.       Begin OptionButton OptionCymbal 
  180.          BackColor       =   &H00C0C0C0&
  181.          Caption         =   "High Hat 1"
  182.          FontBold        =   0   'False
  183.          FontItalic      =   0   'False
  184.          FontName        =   "MS Sans Serif"
  185.          FontSize        =   8.25
  186.          FontStrikethru  =   0   'False
  187.          FontUnderline   =   0   'False
  188.          Height          =   255
  189.          Index           =   0
  190.          Left            =   120
  191.          TabIndex        =   15
  192.          Top             =   360
  193.          Value           =   -1  'True
  194.          Width           =   1215
  195.       End
  196.    End
  197.    Begin Frame Frame2 
  198.       BackColor       =   &H00C0C0C0&
  199.       Caption         =   "Drum Beats"
  200.       FontBold        =   0   'False
  201.       FontItalic      =   0   'False
  202.       FontName        =   "MS Sans Serif"
  203.       FontSize        =   8.25
  204.       FontStrikethru  =   0   'False
  205.       FontUnderline   =   0   'False
  206.       Height          =   1455
  207.       Left            =   120
  208.       TabIndex        =   12
  209.       Top             =   480
  210.       Width           =   1575
  211.       Begin OptionButton OptionDrums 
  212.          BackColor       =   &H00C0C0C0&
  213.          Caption         =   "Fill 1"
  214.          FontBold        =   0   'False
  215.          FontItalic      =   0   'False
  216.          FontName        =   "MS Sans Serif"
  217.          FontSize        =   8.25
  218.          FontStrikethru  =   0   'False
  219.          FontUnderline   =   0   'False
  220.          Height          =   255
  221.          Index           =   2
  222.          Left            =   120
  223.          TabIndex        =   1
  224.          Top             =   1080
  225.          Width           =   1215
  226.       End
  227.       Begin OptionButton OptionDrums 
  228.          BackColor       =   &H00C0C0C0&
  229.          Caption         =   "Beat 2"
  230.          FontBold        =   0   'False
  231.          FontItalic      =   0   'False
  232.          FontName        =   "MS Sans Serif"
  233.          FontSize        =   8.25
  234.          FontStrikethru  =   0   'False
  235.          FontUnderline   =   0   'False
  236.          Height          =   255
  237.          Index           =   1
  238.          Left            =   120
  239.          TabIndex        =   2
  240.          Top             =   720
  241.          Width           =   1215
  242.       End
  243.       Begin OptionButton OptionDrums 
  244.          BackColor       =   &H00C0C0C0&
  245.          Caption         =   "Beat 1"
  246.          FontBold        =   0   'False
  247.          FontItalic      =   0   'False
  248.          FontName        =   "MS Sans Serif"
  249.          FontSize        =   8.25
  250.          FontStrikethru  =   0   'False
  251.          FontUnderline   =   0   'False
  252.          Height          =   255
  253.          Index           =   0
  254.          Left            =   120
  255.          TabIndex        =   13
  256.          Top             =   360
  257.          Value           =   -1  'True
  258.          Width           =   1215
  259.       End
  260.    End
  261.    Begin CommandButton CmdStop 
  262.       Caption         =   "Stop"
  263.       Height          =   495
  264.       Left            =   5640
  265.       TabIndex        =   11
  266.       Top             =   3000
  267.       Width           =   1455
  268.    End
  269.    Begin CommandButton CmdStart 
  270.       Caption         =   "Start"
  271.       Height          =   495
  272.       Left            =   3960
  273.       TabIndex        =   10
  274.       Top             =   3000
  275.       Width           =   1455
  276.    End
  277.    Begin PictureBox Picture1 
  278.       BackColor       =   &H00C0C0C0&
  279.       BorderStyle     =   0  'None
  280.       Height          =   435
  281.       Left            =   0
  282.       ScaleHeight     =   435
  283.       ScaleWidth      =   3915
  284.       TabIndex        =   4
  285.       Top             =   0
  286.       Width           =   3915
  287.       Begin ComboBox OutputDevCombo 
  288.          Height          =   300
  289.          Left            =   120
  290.          Style           =   2  'Dropdown List
  291.          TabIndex        =   5
  292.          Top             =   60
  293.          Width           =   3495
  294.       End
  295.    End
  296.    Begin Frame Frame1 
  297.       BackColor       =   &H00C0C0C0&
  298.       Caption         =   "MIDI Note Value"
  299.       FontBold        =   0   'False
  300.       FontItalic      =   0   'False
  301.       FontName        =   "MS Sans Serif"
  302.       FontSize        =   8.25
  303.       FontStrikethru  =   0   'False
  304.       FontUnderline   =   0   'False
  305.       Height          =   1935
  306.       Left            =   3960
  307.       TabIndex        =   3
  308.       Top             =   960
  309.       Width           =   3135
  310.       Begin VIndicator VuSnare 
  311.          BackColor       =   &H00000000&
  312.          BevelInner      =   0  'None
  313.          BevelOuter      =   1  'Raised
  314.          BevelWidth      =   1
  315.          Border          =   1  'Single Width
  316.          BorderWidth     =   1
  317.          Height          =   1245
  318.          ItemBackColor   =   &H00000000&
  319.          ItemCount1      =   5
  320.          ItemCount2      =   3
  321.          ItemCount3      =   2
  322.          ItemForeColor1  =   &H0000FF00&
  323.          ItemForeColor2  =   &H0000FFFF&
  324.          ItemForeColor3  =   &H000000FF&
  325.          Left            =   1680
  326.          LinkControl     =   ""
  327.          LinkProperty    =   ""
  328.          Max             =   100
  329.          Min             =   0
  330.          ThreeD          =   -1  'True
  331.          Top             =   600
  332.          Value           =   0
  333.          Width           =   300
  334.       End
  335.       Begin VIndicator VuKick 
  336.          BackColor       =   &H00000000&
  337.          BevelInner      =   0  'None
  338.          BevelOuter      =   1  'Raised
  339.          BevelWidth      =   1
  340.          Border          =   1  'Single Width
  341.          BorderWidth     =   1
  342.          Height          =   1245
  343.          ItemBackColor   =   &H00000000&
  344.          ItemCount1      =   5
  345.          ItemCount2      =   3
  346.          ItemCount3      =   2
  347.          ItemForeColor1  =   &H0000FF00&
  348.          ItemForeColor2  =   &H0000FFFF&
  349.          ItemForeColor3  =   &H000000FF&
  350.          Left            =   120
  351.          LinkControl     =   ""
  352.          LinkProperty    =   ""
  353.          Max             =   100
  354.          Min             =   0
  355.          ThreeD          =   -1  'True
  356.          Top             =   600
  357.          Value           =   0
  358.          Width           =   300
  359.       End
  360.       Begin HSlider HSliderNote1 
  361.          BackColor       =   &H00C0C0C0&
  362.          BevelInner      =   0  'None
  363.          BevelOuter      =   1  'Raised
  364.          BevelWidth      =   1
  365.          BorderWidth     =   1
  366.          Gap             =   3
  367.          Height          =   495
  368.          LargeChange     =   1
  369.          Left            =   480
  370.          LinkControl     =   ""
  371.          LinkProperty    =   ""
  372.          Max             =   127
  373.          Min             =   0
  374.          ThumbHeight     =   350
  375.          ThumbStyle      =   3  'Lined
  376.          ThumbWidth      =   220
  377.          TickColor       =   &H00000000&
  378.          TickCount       =   5
  379.          TickLength      =   4
  380.          TickMarks       =   3  'Both
  381.          TickWidth       =   1
  382.          Top             =   1320
  383.          TrackBevel      =   1  'Raised
  384.          TrackWidth      =   0
  385.          Value           =   36
  386.          Width           =   975
  387.       End
  388.       Begin HSlider HSliderNote2 
  389.          BackColor       =   &H00C0C0C0&
  390.          BevelInner      =   0  'None
  391.          BevelOuter      =   1  'Raised
  392.          BevelWidth      =   1
  393.          BorderWidth     =   1
  394.          Gap             =   3
  395.          Height          =   495
  396.          LargeChange     =   1
  397.          Left            =   2040
  398.          LinkControl     =   ""
  399.          LinkProperty    =   ""
  400.          Max             =   127
  401.          Min             =   0
  402.          ThumbHeight     =   350
  403.          ThumbStyle      =   3  'Lined
  404.          ThumbWidth      =   220
  405.          TickColor       =   &H00000000&
  406.          TickCount       =   5
  407.          TickLength      =   4
  408.          TickMarks       =   3  'Both
  409.          TickWidth       =   1
  410.          Top             =   1320
  411.          TrackBevel      =   1  'Raised
  412.          TrackWidth      =   0
  413.          Value           =   38
  414.          Width           =   975
  415.       End
  416.       Begin Label Label1 
  417.          Alignment       =   2  'Center
  418.          BackColor       =   &H00C0C0C0&
  419.          Caption         =   "Snare MIDI Value"
  420.          FontBold        =   0   'False
  421.          FontItalic      =   0   'False
  422.          FontName        =   "MS Sans Serif"
  423.          FontSize        =   8.25
  424.          FontStrikethru  =   0   'False
  425.          FontUnderline   =   0   'False
  426.          Height          =   255
  427.          Index           =   1
  428.          Left            =   1680
  429.          TabIndex        =   9
  430.          Top             =   360
  431.          Width           =   1335
  432.       End
  433.       Begin Label Label1 
  434.          Alignment       =   2  'Center
  435.          BackColor       =   &H00C0C0C0&
  436.          Caption         =   "Kick MIDI Value"
  437.          FontBold        =   0   'False
  438.          FontItalic      =   0   'False
  439.          FontName        =   "MS Sans Serif"
  440.          FontSize        =   8.25
  441.          FontStrikethru  =   0   'False
  442.          FontUnderline   =   0   'False
  443.          Height          =   255
  444.          Index           =   0
  445.          Left            =   120
  446.          TabIndex        =   8
  447.          Top             =   360
  448.          Width           =   1335
  449.       End
  450.       Begin Label LabelNote1 
  451.          Alignment       =   2  'Center
  452.          BackColor       =   &H00000000&
  453.          BorderStyle     =   1  'Fixed Single
  454.          Caption         =   "36"
  455.          FontBold        =   0   'False
  456.          FontItalic      =   0   'False
  457.          FontName        =   "MS Sans Serif"
  458.          FontSize        =   12
  459.          FontStrikethru  =   0   'False
  460.          FontUnderline   =   0   'False
  461.          ForeColor       =   &H0000FF00&
  462.          Height          =   330
  463.          Left            =   480
  464.          TabIndex        =   7
  465.          Top             =   960
  466.          Width           =   975
  467.       End
  468.       Begin Label LabelNote2 
  469.          Alignment       =   2  'Center
  470.          BackColor       =   &H00000000&
  471.          BorderStyle     =   1  'Fixed Single
  472.          Caption         =   "38"
  473.          FontBold        =   0   'False
  474.          FontItalic      =   0   'False
  475.          FontName        =   "MS Sans Serif"
  476.          FontSize        =   12
  477.          FontStrikethru  =   0   'False
  478.          FontUnderline   =   0   'False
  479.          ForeColor       =   &H0000FF00&
  480.          Height          =   330
  481.          Left            =   2040
  482.          TabIndex        =   6
  483.          Top             =   960
  484.          Width           =   975
  485.       End
  486.    End
  487.    Begin Frame FrameTempo 
  488.       BackColor       =   &H00C0C0C0&
  489.       Caption         =   "Tempo"
  490.       FontBold        =   0   'False
  491.       FontItalic      =   0   'False
  492.       FontName        =   "MS Sans Serif"
  493.       FontSize        =   8.25
  494.       FontStrikethru  =   0   'False
  495.       FontUnderline   =   0   'False
  496.       Height          =   855
  497.       Left            =   3960
  498.       TabIndex        =   0
  499.       Top             =   0
  500.       Width           =   3135
  501.       Begin HSlider HSliderTempo 
  502.          BackColor       =   &H00C0C0C0&
  503.          BevelInner      =   1  'Raised
  504.          BevelOuter      =   0  'None
  505.          BevelWidth      =   1
  506.          BorderWidth     =   1
  507.          Gap             =   3
  508.          Height          =   435
  509.          LargeChange     =   10
  510.          Left            =   120
  511.          LinkControl     =   "[None]"
  512.          LinkProperty    =   ""
  513.          Max             =   1
  514.          Min             =   150
  515.          ThumbHeight     =   335
  516.          ThumbStyle      =   2  'Pointed Down
  517.          ThumbWidth      =   200
  518.          TickColor       =   &H00000000&
  519.          TickCount       =   20
  520.          TickLength      =   4
  521.          TickMarks       =   2  'Bottom
  522.          TickWidth       =   1
  523.          Top             =   300
  524.          TrackBevel      =   2  'Inset
  525.          TrackWidth      =   2
  526.          Value           =   65
  527.          Width           =   2895
  528.       End
  529.    End
  530.    Begin MIDIOutput MIDIOutput1 
  531.       DeviceID        =   0
  532.       Left            =   3600
  533.       Top             =   1320
  534.       VolumeLeft      =   0
  535.       VolumeRight     =   0
  536.    End
  537.    Begin Menu FileMenu 
  538.       Caption         =   "&File"
  539.       Begin Menu FileExit 
  540.          Caption         =   "E&xit"
  541.       End
  542.    End
  543.    Begin Menu mnuFile 
  544.       Caption         =   "&Help"
  545.       Begin Menu mnuAbout 
  546.          Caption         =   "&About CoolDrum..."
  547.       End
  548.    End
  549. End
  550. Option Explicit
  551.  
  552. ' CoolDrum
  553. ' =======
  554. ' The CoolDrum example is to demonstrate how the queue timing works and
  555. ' to show a very simple example of creating MIDI music in real-time.  This
  556. ' example can be expanded to do all kinds of really neat things.
  557.  
  558. ' MIDIOutput Queue
  559. ' ==============
  560. ' Whenever the MIDIOutput queue becomes empty, it automatically resets the
  561. ' time (ms) to 0. Once you place another event into the queue, it will
  562. ' restart automatically at 0 ms.  As long as events are in the queue, the
  563. ' queue will not reset to 0.  It will continue  to count up in ms and
  564. ' sending events when scheduled.
  565.  
  566. ' The MIDI Output has a QueueEmpty Event that is fired as soon as the queue
  567. ' sends its last event.  At that moment, the timer in the queue is reset
  568. ' back to 0.  You can use this event to notify your program that more events
  569. ' are needed in the MIDI Output.  As soon as the first event is received in
  570. ' the MIDI Output, playback will start right back up automatically.
  571.  
  572. ' Another thing that you should understand about the MIDI Output is that it
  573. ' can be running (sending events as scheduled) and also receiving more
  574. ' events to schedule for sending. It will automatically sort these new
  575. ' events by time -- place them into the correct order to be sent.  The only
  576. ' limitation is if the schedule time has already passed, the event is
  577. ' discarded.
  578.  
  579. Sub CloseOutputDevice ()
  580.     '
  581.     ' Restore volume before closing
  582.     '
  583.     If MIDIOutput1.State >= MIDISTATE_OPEN Then
  584.     '
  585.     ' Close
  586.     '
  587.     MIDIOutput1.Action = MIDIOUT_CLOSE
  588.     End If
  589. End Sub
  590.  
  591. Sub CmdStart_Click ()
  592.     StartPlay
  593.     
  594.     ' Enable the VU timer.  This timer is used to allow the VU
  595.     ' meters to slowly decay in value.
  596.     Timer1.Enabled = True
  597. End Sub
  598.  
  599. Sub CmdStop_Click ()
  600.     
  601.     StopPlay
  602.  
  603.     ' Disable the VU meter timer and zero out the VU values
  604.     Timer1.Enabled = False
  605.     VuKick = 0
  606.     VuSnare = 0
  607. End Sub
  608.  
  609. ' Queue a few MIDI events for a bass part
  610. Sub DBass1 ()
  611.     Dim Transpose As Integer
  612.     Transpose = VSlider1.Value
  613.  
  614.     ' Send MIDI message data now
  615.     MIDIOutput1.MessageTag = 4000 + 100
  616.     SendMIDIOut (NOTE_ON + 1), (36 + Transpose), 0, 0, MIDIOUT_SEND
  617.  
  618.     ' Queue MIDI message data
  619.     SendMIDIOut (NOTE_ON + 1), (36 + Transpose), 100, (750 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  620.     SendMIDIOut (NOTE_ON + 1), (36 + Transpose), 0, (850 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  621.     SendMIDIOut (NOTE_ON + 1), (36 + Transpose), 100, (1000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  622.     SendMIDIOut (NOTE_ON + 1), (36 + Transpose), 0, (1500 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  623.     SendMIDIOut (NOTE_ON + 1), (36 + Transpose), 100, (2000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  624.  
  625. End Sub
  626.  
  627. ' Queue a few MIDI events for a bass part
  628. Sub DBass2 ()
  629.     Dim Transpose As Integer
  630.     Transpose = VSlider1.Value
  631.     
  632.     ' Queue MIDI message data
  633.     SendMIDIOut (NOTE_ON + 1), (41 + Transpose), 100, (1000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  634.     SendMIDIOut (NOTE_ON + 1), (41 + Transpose), 0, (1250 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  635.     SendMIDIOut (NOTE_ON + 1), (41 + Transpose), 100, (1500 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  636.     SendMIDIOut (NOTE_ON + 1), (41 + Transpose), 0, (2000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  637.  
  638. End Sub
  639.  
  640. '  Queue a few MIDI events for a drum part
  641. Sub DrumBeat1 ()
  642.  
  643.     ' Queue MIDI message data
  644.     MIDIOutput1.MessageTag = 1000 + 100
  645.     SendMIDIOut (NOTE_ON + 9), (HSliderNote1), 100, (1000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  646.     
  647.     MIDIOutput1.MessageTag = 2000 + 100
  648.     SendMIDIOut (NOTE_ON + 9), (HSliderNote2), 100, (2000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  649. End Sub
  650.  
  651. ' Queue a few MIDI events for a drum part
  652. Sub DrumBeat2 ()
  653.  
  654.     ' Queue MIDI message data
  655.     MIDIOutput1.MessageTag = 1000 + 100
  656.     SendMIDIOut (NOTE_ON + 9), (HSliderNote1), 100, (1000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  657.  
  658.     MIDIOutput1.MessageTag = 1000 + 100
  659.     SendMIDIOut (NOTE_ON + 9), (HSliderNote1), 100, (1500 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  660.  
  661.     MIDIOutput1.MessageTag = 2000 + 120
  662.     SendMIDIOut (NOTE_ON + 9), (HSliderNote2), 120, (2000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  663. End Sub
  664.  
  665. ' Queue a few MIDI events for starting 4 count click
  666. Sub DrumBeatStartingClicks ()
  667.     MIDIOutput1.MessageTag = 5000 + 100
  668.  
  669.     SendMIDIOut (NOTE_ON + 9), (HSliderNote2 - 1), 127, (1000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  670.     SendMIDIOut (NOTE_ON + 9), (HSliderNote2 - 1), 127, (2000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  671.     SendMIDIOut (NOTE_ON + 9), (HSliderNote2 - 1), 127, (3000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  672.     SendMIDIOut (NOTE_ON + 9), (HSliderNote2 - 1), 127, (4000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  673. End Sub
  674.  
  675. ' Queue a few MIDI events for a drum part
  676. Sub DrumFill1 ()
  677.  
  678.     MIDIOutput1.MessageTag = 2000 + 100
  679.     SendMIDIOut (NOTE_ON + 9), (HSliderNote2), 100, (500 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  680.     
  681.     MIDIOutput1.MessageTag = 2000 + 127
  682.     SendMIDIOut (NOTE_ON + 9), (HSliderNote2), 127, (750 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  683.     
  684.     MIDIOutput1.MessageTag = 1000 + 100
  685.     SendMIDIOut (NOTE_ON + 9), (HSliderNote1), 100, (1000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  686.     'Cymbal crash
  687.     SendMIDIOut (NOTE_ON + 9), (HSliderNote1 + 13), 100, (1000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  688.  
  689.     
  690.     MIDIOutput1.MessageTag = 1000 + 127
  691.     SendMIDIOut (NOTE_ON + 9), (HSliderNote1), 127, (1500 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  692.  
  693.     MIDIOutput1.MessageTag = 2000 + 127
  694.     SendMIDIOut (NOTE_ON + 9), (HSliderNote2), 127, (2000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  695.  
  696. End Sub
  697.  
  698. 'Queue a few MIDI events for a high hat part
  699. Sub DrumHH1 ()
  700.     Dim HHSticked As Integer
  701.     Dim HHOpen As Integer
  702.     HHSticked = 42
  703.     HHOpen = 46
  704.  
  705.     MIDIOutput1.MessageTag = 3000 + 100
  706.     SendMIDIOut (NOTE_ON + 9), (HHOpen), 127, (500 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  707.     SendMIDIOut (NOTE_ON + 9), (HHSticked), 100, (1000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  708.     SendMIDIOut (NOTE_ON + 9), (HHSticked), 100, (1500 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  709.     SendMIDIOut (NOTE_ON + 9), (HHSticked), 100, (2000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  710.  
  711. End Sub
  712.  
  713. ' Queue a few MIDI events for a high hat part
  714. Sub DrumHH2 ()
  715.     Dim HHSticked As Integer
  716.     Dim HHOpen As Integer
  717.     HHSticked = 42
  718.     HHOpen = 46
  719.  
  720.     MIDIOutput1.MessageTag = 3000 + 100
  721.     SendMIDIOut (NOTE_ON + 9), (HHSticked), 127, (250 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  722.     SendMIDIOut (NOTE_ON + 9), (HHOpen), 100, (500 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  723.     SendMIDIOut (NOTE_ON + 9), (HHSticked), 100, (750 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  724.     SendMIDIOut (NOTE_ON + 9), (HHSticked), 100, (1000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  725.     SendMIDIOut (NOTE_ON + 9), (HHSticked), 100, (1250 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  726.     SendMIDIOut (NOTE_ON + 9), (HHSticked), 127, (1500 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  727.     SendMIDIOut (NOTE_ON + 9), (HHSticked), 100, (1750 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  728.     SendMIDIOut (NOTE_ON + 9), (HHSticked), 100, (2000 * HSliderTempo.Value / 100), MIDIOUT_QUEUE
  729.  
  730. End Sub
  731.  
  732. Sub FileExit_Click ()
  733.     
  734.     End
  735. End Sub
  736.  
  737. Sub Form_Load ()
  738.     Dim i As Integer
  739.  
  740.     '
  741.     ' Fill output device combo box
  742.     '
  743.     For i = -1 To MIDIOutput1.DeviceCount - 1
  744.     MIDIOutput1.DeviceID = i
  745.     OutputDevCombo.AddItem MIDIOutput1.ProductName
  746.     Next
  747.     '
  748.     ' Select first in list
  749.     '
  750.     MIDIOutput1.DeviceID = -1
  751.     OutputDevCombo.ListIndex = 0
  752.     
  753. End Sub
  754.  
  755. Sub Form_Unload (Cancel As Integer)
  756.     CloseOutputDevice
  757. End Sub
  758.  
  759. Sub HSliderNote1_Change ()
  760.      LabelNote1.Caption = Str(HSliderNote1)
  761. End Sub
  762.  
  763. Sub HSliderNote1_Scroll ()
  764.      LabelNote1.Caption = Str(HSliderNote1)
  765. End Sub
  766.  
  767. Sub HSliderNote2_Change ()
  768.     LabelNote2.Caption = Str(HSliderNote2)
  769. End Sub
  770.  
  771. Sub HSliderNote2_Scroll ()
  772.     LabelNote2.Caption = Str(HSliderNote2)
  773. End Sub
  774.  
  775. Sub MIDIOutput1_Error (ErrorCode As Integer, ErrorMessage As String)
  776.     MsgBox ErrorMessage
  777. End Sub
  778.  
  779. Sub MIDIOutput1_MessageSent (MessageTag As Long)
  780.  
  781.     ' MessageTag has been passed to the program right as the MIDI message was
  782.     ' sent to the output.  We coded the MessageTag with velocity data as we queued
  783.     ' the events.  Now will set the VU meters with that velocity data.
  784.     Select Case Left(MessageTag, 1)
  785.     Case Is = 1
  786.         VuKick.Value = MessageTag - 1000
  787.     Case Is = 2
  788.         VuSnare.Value = MessageTag - 2000
  789.     End Select
  790.     
  791. End Sub
  792.  
  793. Sub MIDIOutput1_QueueEmpty ()
  794.     'The MIDIOutput1 queue is empty.  Let's put some more MIDI data into the queue
  795.     If OptionCymbal(0) = True Then DrumHH1
  796.     If OptionCymbal(1) = True Then DrumHH2
  797.     If OptionDrums(0) = True Then DrumBeat1
  798.     If OptionDrums(1) = True Then DrumBeat2
  799.     If OptionDrums(2) = True Then DrumFill1
  800.     If OptionBass(0) = True Then DBass1
  801.     If OptionBass(1) = True Then DBass2
  802. End Sub
  803.  
  804. Sub MidiReset ()
  805.     Dim x As Integer
  806.     'Turn off all MIDI Notes on all channels.
  807.     For x = 176 To 191
  808.       MIDIOutput1.Message = x
  809.       MIDIOutput1.Data1 = 123
  810.       MIDIOutput1.Data2 = 0
  811.       MIDIOutput1.Action = MIDIOUT_SEND
  812.     Next
  813.     MIDIOutput1.Action = MIDIOUT_STOP
  814. End Sub
  815.  
  816. Sub mnuAbout_Click ()
  817.     AboutBox1.Show
  818. End Sub
  819.  
  820. Sub OpenOutputDevice ()
  821.     '
  822.     ' Open selected device
  823.     '
  824.     MIDIOutput1.DeviceID = OutputDevCombo.ListIndex - 1
  825.     MIDIOutput1.Action = MIDIOUT_OPEN
  826.     
  827. End Sub
  828.  
  829. Sub OutputDevCombo_Click ()
  830.     '
  831.     ' Stop and Close currently opened device (if any)
  832.     '
  833.     StopPlay
  834. End Sub
  835.  
  836. Sub SendMIDIOut (Message As Integer, Data1 As Integer, Data2 As Integer, TimeVal As Long, Action As Integer)
  837.  
  838.     ' Put MIDI data in MIDIoutput queue
  839.     MIDIOutput1.Message = Message
  840.     MIDIOutput1.Data1 = Data1
  841.     MIDIOutput1.Data2 = Data2
  842.     MIDIOutput1.Time = TimeVal
  843.     MIDIOutput1.Action = Action
  844.  
  845. End Sub
  846.  
  847. Sub StartPlay ()
  848.     OpenOutputDevice
  849.     MIDIOutput1.Action = MIDIOUT_START
  850.     
  851.     'Queue the 4 count click off events
  852.     DrumBeatStartingClicks
  853.     CmdStart.Enabled = False
  854.     CmdStop.Enabled = True
  855. End Sub
  856.  
  857. Sub StopPlay ()
  858.     MIDIOutput1.Action = MIDIOUT_STOP
  859.  
  860.     ' Turn off any bass notes still playing on MIDI channel 2
  861.     MidiReset
  862.     CloseOutputDevice
  863.     CmdStart.Enabled = True
  864.     CmdStop.Enabled = False
  865. End Sub
  866.  
  867. Sub Timer1_Timer ()
  868.     VuKick.Value = Int(VuKick.Value / 2 - .5)
  869.     VuSnare.Value = Int(VuSnare.Value / 2 - .5)
  870. End Sub
  871.  
  872.